Libris Britannia 4/science library(b).zip/science library(b)/PROGRAMM/PASCAL/2009.ZIP/STRLINK.ZIP/STRLINK.PAS

Pascal/Delphi Source File | 1989-08-28 | 21KB | 642 lines

{$A+,B-,D+,E+,F-,I-,L+,N-,O-,R-,S+,V+}
{$DEFINE TPRO5}

UNIT StrLink;

INTERFACE {section}

USES
   {$IFDEF TPRO5}
       TpString,
   {$ENDIF}
   Objects,
   ObjectA,
   StrObj;

TYPE
   SortedOrderType = (ForwardOrder,
              ReverseOrder,
              AscendingOrder,
              DescendingOrder);

   StrLinkList
    = OBJECT(LinkList)
      CurrentStrPtr     : StrObjectPtr;
      UniqueStringsOnly : BOOLEAN;
      SortedOrder       : SortedOrderType;
      CaseMatters       : BOOLEAN;

      CONSTRUCTOR Init(UniqueStrings : BOOLEAN;
                       SortSpecifier : SortedOrderType;
                       IgnoreCase    : BOOLEAN);

      FUNCTION  GetSpecificString(NodePos : LONGINT) : STRING;
      PROCEDURE DeleteSpecificString(NodePos : LONGINT);

      FUNCTION  ReadStrings(TheFilename : STRING) : BYTE;
      FUNCTION  WriteStrings(TheFilename : STRING;
                             AppendFile  : BOOLEAN) : BYTE;

      PROCEDURE AddString(TheStr : STRING);
      PROCEDURE DeleteString(TheStr : STRING);
      FUNCTION  Exists(TheStr : STRING) : BOOLEAN;
      FUNCTION  ExistsSubstring(TheSubStr : STRING) : BOOLEAN;
      PROCEDURE DeleteStringsWithoutSubstring(TheSubStr  : STRING;
                                              IgnoreCase : BOOLEAN);
      PROCEDURE DeleteStringsWithSubstring(TheSubStr  : STRING;
                                           IgnoreCase : BOOLEAN);
      PROCEDURE DeleteDuplicates;
      PROCEDURE DeleteLeadNullStrings;
      PROCEDURE DeleteNullStrings;
      PROCEDURE DeleteTrailNullStrings;

      PROCEDURE InitCurrent;
      FUNCTION  CurrentString : STRING;
      PROCEDURE ChangeCurrentString(NewStr : STRING);
      FUNCTION  FirstString : STRING;
      FUNCTION  LastString : STRING;
      PROCEDURE Advance;
      PROCEDURE Retreat;
      FUNCTION  MoreStrings : BOOLEAN;
      FUNCTION  NoMoreStrings : BOOLEAN
      END;


IMPLEMENTATION {section}


{$IFNDEF TPRO5}
{============================================================================}
FUNCTION  StUpCase(TheStr : STRING) : STRING;

   {Returns a string, converted to uppercase.}

VAR
   Index : BYTE;

BEGIN {StUpCase}
FOR Index := 1 TO LENGTH(TheStr)
 DO TheStr[Index] := UPCASE(TheStr[Index]);

StUpCase := TheStr
END; {StUpCase}
{============================================================================}
{$ENDIF}

{- - - - - - - - - - - - - - - - - - -  - - - - - - - - - - - - - - - - - - -}

{============================================================================}
CONSTRUCTOR StrLinkList.Init(UniqueStrings : BOOLEAN;
                             SortSpecifier : SortedOrderType;
                             IgnoreCase    : BOOLEAN);

   {This procedure initializes the StrLinkList.}

BEGIN {StrLinkList.Init}
CurrentStrPtr     := NIL;

UniqueStringsOnly := UniqueStrings;
SortedOrder       := SortSpecifier;
CaseMatters       := NOT IgnoreCase;

LinkList.Init
END; {StrLinkList.Init}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.GetSpecificString(NodePos : LONGINT) : STRING;

   {This function returns a string from the StrLinkList based on the position
of a particular Str in the list.  The position is represented by NodePos.  It
returns a null string if NodePos is <= 0 or if it is > Total.  CurrentPtr is
set to the specified string.}

BEGIN {StrLinkList.GetSpecificString}
{Initialize.}
CurrentStrPtr := StrObjectPtr(Specific(NodePos));

IF (CurrentStrPtr = NIL)
 THEN GetSpecificString := ''
 ELSE GetSpecificString := CurrentStrPtr^.GetString
END; {StrLinkList.GetSpecificString}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteSpecificString(NodePos : LONGINT);

   {This procedure deletes a string from the StrLinkList based on the position
of the node, represented by NodePos.  It does nothing if NodePos is <= 0 or if
it is > Total.  CurrentPtr is set to NIL afterwards.}

BEGIN {StrLinkList.DeleteSpecificString}
{Initialize.}
CurrentStrPtr := StrObjectPtr(Specific(NodePos));

IF (CurrentStrPtr <> NIL)
 THEN
    BEGIN
    Remove(CurrentStrPtr);
    DISPOSE(CurrentStrPtr,Done);
    CurrentStrPtr := NIL
    END
END; {StrLinkList.DeleteSpecificString}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.ReadStrings(TheFilename : STRING) : BYTE;

   {Reads strings from TheFilename and adds them to the link list.  IORESULT
is returned as the result.}

VAR
   ReadFile : TEXT;
   ReadBuf  : ARRAY [1..2048] OF CHAR;
   ReadLine : STRING;

BEGIN {StrLinkList.ReadStrings}
ASSIGN(ReadFile,TheFilename);
RESET(ReadFile);
SETTEXTBUF(ReadFile,ReadBuf);

WHILE NOT EOF(ReadFile)
 DO BEGIN
    READLN(ReadFile,ReadLine);
    AddString(ReadLine)
    END;

{Wrap up.}
ReadStrings := IORESULT
END; {StrLinkList.ReadStrings}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.WriteStrings(TheFilename : STRING;
                                   AppendFile  : BOOLEAN) : BYTE;

   {Writes strings from TheFilename and adds them to the link list.  IORESULT
is returned as the result.}

VAR
   WriteFile : TEXT;
   WriteBuf  : ARRAY [1..2048] OF CHAR;
   WriteLine : STRING;

BEGIN {StrLinkList.WriteStrings}
ASSIGN(WriteFile,TheFilename);
IF AppendFile
 THEN SYSTEM.APPEND(WriteFile)
 ELSE REWRITE(WriteFile);
SETTEXTBUF(WriteFile,WriteBuf);

InitCurrent;
WHILE MoreStrings
 DO BEGIN
    WRITELN(WriteFile,CurrentStrPtr^.GetString);
    Advance
    END;

{Wrap up.}
WriteStrings := IORESULT
END; {StrLinkList.WriteStrings}
{============================================================================}

{============================================================================}
PROCEDURE   StrLinkList.AddString(TheStr : STRING);

   {This procedure stores TheStr in the StrLinkList.  It does nothing if the
string is redundant AND UniqueStringsOnly is set to TRUE.  CurrentPtr is
undefined after making this call.}

BEGIN {StrLinkList.AddString}
IF (UniqueStringsOnly AND Exists(TheStr))
 THEN EXIT; {no need to hang around here, eh?}

IF (First = NIL)
 THEN
    Insert(NEW(StrObjectPtr,Init(TheStr)))
 ELSE
    CASE SortedOrder OF
      ForwardOrder :
    Append(NEW(StrObjectPtr,Init(TheStr)));
      ReverseOrder :
    Insert(NEW(StrObjectPtr,Init(TheStr)));
      AscendingOrder :
        BEGIN
        CurrentStrPtr := StrObjectPtr(First);
        IF CaseMatters
         THEN
            WHILE (MoreStrings
             AND (CurrentStrPtr^.GetString < TheStr))
             DO Advance
         ELSE
            {$IFDEF TPRO5}
                WHILE (MoreStrings
                 AND (CompUCString(CurrentStrPtr^.GetString,TheStr) = Less))
                  DO Advance;
            {$ELSE}
                WHILE (MoreStrings
                 AND (StUpCase(CurrentStrPtr^.GetString) < StUpCase(TheStr)))
                  DO Advance;
            {$ENDIF}

        {CurrentStrPtr now points to the first Str coming after TheStr, or it
           has a NIL value.}
        IF NoMoreStrings
         THEN Append(NEW(StrObjectPtr,Init(TheStr)))
         ELSE Before(NEW(StrObjectPtr,Init(TheStr)),CurrentStrPtr)
        END;
      DescendingOrder :
        BEGIN
        CurrentStrPtr := StrObjectPtr(First);
        IF CaseMatters
         THEN
            WHILE (MoreStrings
             AND (CurrentStrPtr^.GetString > TheStr))
             DO Advance
         ELSE
            {$IFDEF TPRO5}
                WHILE (MoreStrings
                 AND (CompUCString(CurrentStrPtr^.GetString,
                                   TheStr) = Greater))
                  DO Advance;
            {$ELSE}
                WHILE (MoreStrings
                 AND (StUpCase(CurrentStrPtr^.GetString) > StUpCase(TheStr)))
                  DO Advance;
            {$ENDIF}

        {CurrentStrPtr now points to the first Str coming after TheStr, or it
           has a NIL value.}
        IF NoMoreStrings
         THEN Append(NEW(StrObjectPtr,Init(TheStr)))
         ELSE Before(NEW(StrObjectPtr,Init(TheStr)),CurrentStrPtr)
        END;
     END; {CASE}
END; {AddString}
{============================================================================}

{============================================================================}
PROCEDURE   StrLinkList.DeleteString(TheStr : STRING);

   {This procedure deletes a string from the StrLinkList.  It does nothing if
the string doesn't exist.  CurrentPtr is NIL after making this call.}

BEGIN {StrLinkList.DeleteString}
IF Exists(TheStr)
 THEN
    BEGIN
    CurrentStrPtr := StrObjectPtr(First);
    WHILE (CurrentStrPtr^.GetString <> TheStr)
     DO CurrentStrPtr := StrObjectPtr(CurrentStrPtr^.Next);

    {CurrentStrPtr now points to the proper string.}
    Remove(CurrentStrPtr);
    DISPOSE(CurrentStrPtr,Done);
    CurrentStrPtr := NIL
    END
END; {StrLinkList.DeleteString}
{============================================================================}

{============================================================================}
FUNCTION    StrLinkList.Exists(TheStr : STRING) : BOOLEAN;

   {This function determines if the string is on the StrLinkList.}

VAR
   TempBoolean : BOOLEAN;

BEGIN {StrLinkList.Exists}
{Initialize.}
CurrentStrPtr := StrObjectPtr(First);

IF (First = NIL)
 THEN
    Exists := FALSE
 ELSE
    BEGIN
    TempBoolean := FALSE;

    REPEAT
        IF (CurrentStrPtr^.GetString = TheStr)
         THEN TempBoolean := TRUE;
         {ELSE leave TempBoolean alone}

        CurrentStrPtr := StrObjectPtr(Next(CurrentStrPtr))
     UNTIL (TempBoolean OR NoMoreStrings);

    Exists := TempBoolean
    END
END; {StrLinkList.Exists}
{============================================================================}

{============================================================================}
FUNCTION    StrLinkList.ExistsSubstring(TheSubStr : STRING) : BOOLEAN;

   {This function determines if a given substring is on the StrLinkList.  If
TheSubString is null and at least one string exists on the list, then the
function returns as TRUE.}

VAR
   TempBoolean : BOOLEAN;

BEGIN {StrLinkList.ExistsSubstring}
{Initialize.}
CurrentStrPtr := StrObjectPtr(First);

IF (First = NIL)
 THEN
    ExistsSubstring := FALSE
 ELSE
    IF (TheSubStr = '')
     THEN
        ExistsSubstring := TRUE
     ELSE
        BEGIN
        TempBoolean := FALSE;

        REPEAT
            IF (POS(TheSubStr,CurrentStrPtr^.GetString) > 0)
             THEN TempBoolean := TRUE;
             {ELSE leave TempBoolean alone}

            CurrentStrPtr := StrObjectPtr(Next(CurrentStrPtr))
         UNTIL (TempBoolean OR NoMoreStrings);

        ExistsSubstring := TempBoolean
        END
END; {StrLinkList.ExistsSubstring}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteStringsWithoutSubstring(TheSubStr  : STRING;
                                                    IgnoreCase : BOOLEAN);

   {This procedure deletes any string that doesn't contain TheSubStr as part
of the string.  No strings are deleted if TheSubString is a null string.  The
IgnoreCase variable dictates whether upper/lower case is relevant.}

VAR
   Index : LONGINT;

BEGIN {StrLinkList.DeleteStringsWithoutSubstring}
{Initialize.}
IF ((TheSubStr = '') OR (First = NIL))
 THEN EXIT; {no need to hang around, eh?}
InitCurrent;
Index := 1;

IF IgnoreCase
 THEN
    BEGIN
    TheSubStr := StUpCase(TheSubStr);
    WHILE (Index <= Total(First))
     DO IF (POS(TheSubStr,StUpCase(GetSpecificString(Index))) = 0)
         THEN DeleteSpecificString(Index)
         ELSE INC(Index)
    END
 ELSE
    WHILE (Index <= Total(First))
     DO IF (POS(TheSubStr,GetSpecificString(Index)) = 0)
         THEN DeleteSpecificString(Index)
         ELSE INC(Index)
END; {StrLinkList.DeleteStringsWithoutSubstring}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteStringsWithSubstring(TheSubStr  : STRING;
                                                 IgnoreCase : BOOLEAN);

   {This procedure deletes any string that DOES contain TheSubStr as part of
the string.  No strings are deleted if TheSubString is a null string.  The
IgnoreCase variable dictates whether upper/lower case is relevant.}

VAR
   Index : LONGINT;

BEGIN {StrLinkList.DeleteStringsWithSubstring}
{Initialize.}
IF ((TheSubStr = '') OR (First = NIL))
 THEN EXIT; {no need to hang around, eh?}
InitCurrent;
Index := 1;

IF IgnoreCase
 THEN
    BEGIN
    TheSubStr := StUpCase(TheSubStr);
    WHILE (Index <= Total(First))
     DO IF (POS(TheSubStr,StUpCase(GetSpecificString(Index))) > 0)
         THEN DeleteSpecificString(Index)
         ELSE INC(Index)
    END
 ELSE
    WHILE (Index <= Total(First))
     DO IF (POS(TheSubStr,GetSpecificString(Index)) > 0)
         THEN DeleteSpecificString(Index)
         ELSE INC(Index)
END; {StrLinkList.DeleteStringsWithSubstring}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteDuplicates;

   {This procedure deletes duplicate strings from the list.}

VAR
   MasterIndex  : LONGINT;
   CurrentIndex : LONGINT;
   TestStr      : STRING;

BEGIN {StrLinkList.DeleteDuplicates}
{Initialize.}
MasterIndex := 1;
InitCurrent;
IF (UniqueStringsOnly OR (Total(First) < 2))
 THEN EXIT; {no need to hang around here, eh?}

{If we get this far, we have at least two strings on the list.}
REPEAT
    TestStr       := GetSpecificString(MasterIndex);  {sets CurrentStrPtr}
    CurrentIndex  := SUCC(MasterIndex);
    CurrentStrPtr := StrObjectPtr(Specific(CurrentIndex));

    REPEAT
        IF (CurrentStrPtr^.GetString = TestStr)
         THEN
            BEGIN
            DeleteSpecificString(CurrentIndex);
            CurrentStrPtr := StrObjectPtr(Specific(CurrentIndex))
            END
         ELSE
            BEGIN
            Advance;
            INC(CurrentIndex)
            END
     UNTIL (CurrentIndex > Total(First));

    INC(MasterIndex)
 UNTIL (MasterIndex >= Total(First));

InitCurrent
END; {StrLinkList.DeleteDuplicates}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteLeadNullStrings;

   {This procedure deletes leading null strings from the list.  Null strings
that exist past the first non-null string in the list are left alone.}

BEGIN {StrLinkList.DeleteLeadNullStrings}
WHILE ((First <> NIL)
 AND (GetSpecificString(1) = ''))
 DO DeleteSpecificString(1)
END; {StrLinkList.DeleteLeadNullStrings}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteNullStrings;

   {This procedure deletes null strings from the list.}

VAR
   Index : LONGINT;

BEGIN {StrLinkList.DeleteNullStrings}
{Initialize.}
IF (First = NIL)
 THEN EXIT; {no need to hang around, eh?}
InitCurrent;
Index := 1;

WHILE (Index <= Total(First))
 DO IF (GetSpecificString(Index) = '')
     THEN DeleteSpecificString(Index)
     ELSE INC(Index)
END; {StrLinkList.DeleteNullStrings}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteTrailNullStrings;

   {This procedure deletes Trailing null strings from the list.  Null strings
that exist before the last non-null string in the list are left alone.}

BEGIN {StrLinkList.DeleteTrailNullStrings}
WHILE ((Last <> NIL)
 AND (GetSpecificString(Total(First)) = ''))
 DO DeleteSpecificString(Total(First))
END; {StrLinkList.DeleteTrailNullStrings}
{============================================================================}

{============================================================================}
PROCEDURE  StrLinkList.InitCurrent;

   {This function initializes CurrentStrPtr to point to the first string on
the LinkList.  NoMoreStrings will return TRUE if there are no strings on the
list.}

BEGIN {StrLinkList.InitCurrent}
CurrentStrPtr := StrObjectPtr(First);
END; {StrLinkList.InitCurrent}
{============================================================================}

{============================================================================}
FUNCTION    StrLinkList.CurrentString : STRING;

   {This function returns the current string in the StrLinkList.  It returns
a null string if the CurrentStrPtr is NIL.  It is up to the calling routine
to use the NoMoreStrings function to see if a string is currently available.}

BEGIN {StrLinkList.CurrentString}
IF NoMoreStrings
 THEN CurrentString := ''
 ELSE CurrentString := CurrentStrPtr^.GetString
END; {StrLinkList.CurrentString}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.ChangeCurrentString(NewStr : STRING);

   {This procedure changes the current string to the new string.}

BEGIN {StrLinkList.ChangeCurrentString}
CurrentStrPtr^.ChangeString(NewStr)
END; {StrLinkList.ChangeCurrentString}
{============================================================================}

{============================================================================}
FUNCTION    StrLinkList.FirstString : STRING;

   {This function simply returns the first String in the LinkList.  It returns
a null string if there are no strings in the list.  It is up to the calling
routine to determine for itself if there are no strings.}

BEGIN {StrLinkList.FirstString}
CurrentStrPtr := StrObjectPtr(First);
IF NoMoreStrings
 THEN FirstString := ''
 ELSE FirstString := CurrentStrPtr^.GetString
END; {StrLinkList.FirstString}
{============================================================================}

{============================================================================}
FUNCTION    StrLinkList.LastString : STRING;

   {This function simply returns the last string in the LinkList.  It returns
a null string if there are no strings in the list.  It is up to the calling
routine to determine for itself if there are no strings.}

BEGIN {StrLinkList.LastString}
CurrentStrPtr := StrObjectPtr(Last);
IF NoMoreStrings
 THEN LastString := ''
 ELSE LastString := CurrentStrPtr^.GetString
END; {StrLinkList.LastString}
{============================================================================}

{============================================================================}
PROCEDURE   StrLinkList.Advance;

   {This procedure simply moves to the next string in the StrLinkList.}

BEGIN {StrLinkList.Advance}
CurrentStrPtr := StrObjectPtr(Next(CurrentStrPtr))
END; {StrLinkList.Advance}
{============================================================================}

{============================================================================}
PROCEDURE   StrLinkList.Retreat;

   {This procedure simply moves to the previous string in the StrLinkList.}

BEGIN {StrLinkList.Retreat}
CurrentStrPtr := StrObjectPtr(Prev(CurrentStrPtr))
END; {StrLinkList.Retreat}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.MoreStrings : BOOLEAN;

   {This function tells the calling routine if there are still some strings
left to go on the link list.}

BEGIN {StrLinkList.MoreStrings}
MoreStrings := (CurrentStrPtr <> NIL)
END; {StrLinkList.MoreStrings}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.NoMoreStrings : BOOLEAN;

   {This function is just the opposite of MoreStrings.  It tells the calling
routine if the string link list has been exhausted.}

BEGIN {StrLinkList.NoMoreStrings}
NoMoreStrings := (CurrentStrPtr = NIL)
END; {StrLinkList.NoMoreStrings}
{============================================================================}


END. {StrLink}